Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/trans.fr_/trans.fr

Text File | 1995-04-25 | 6KB | 201 lines

VERSION 4.00
Begin VB.Form frmODBC
   BackColor       =   &H00C0C0C0&
   Caption         =   "Transfer Bank Funds"
   ClientHeight    =   2490
   ClientLeft      =   2010
   ClientTop       =   2325
   ClientWidth     =   4890
   Height          =   2895
   Left            =   1950
   LinkTopic       =   "Form1"
   ScaleHeight     =   2490
   ScaleWidth      =   4890
   Top             =   1980
   Width           =   5010
   Begin VB.TextBox txtAmount
      Height          =   285
      Left            =   1680
      TabIndex        =   5
      Top             =   2040
      Width           =   1455
   End
   Begin VB.CommandButton cmdQuit
      Cancel          =   -1  'True
      Caption         =   "Quit"
      Height          =   495
      Left            =   3480
      TabIndex        =   7
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton cmdTransfer
      Caption         =   "Transfer"
      Height          =   495
      Left            =   3480
      TabIndex        =   6
      Top             =   360
      Width           =   1215
   End
   Begin VB.ComboBox cmbAccounts
      Height          =   300
      Index           =   1
      Left            =   240
      TabIndex        =   3
      Top             =   1320
      Width           =   2895
   End
   Begin VB.ComboBox cmbAccounts
      Height          =   300
      Index           =   0
      Left            =   240
      TabIndex        =   1
      Top             =   480
      Width           =   2895
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Amount to Transfer:"
      Height          =   195
      Left            =   240
      TabIndex        =   4
      Top             =   2040
      Width           =   1395
   End
   Begin VB.Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Transfer To:"
      Height          =   255
      Index           =   1
      Left            =   240
      TabIndex        =   2
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Transfer From:"
      Height          =   255
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "frmODBC"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdQuit_Click()
    End
End Sub

Private Sub cmdTransfer_Click()
    If cmbAccounts(0).text = "" Or cmbAccounts(1).text = "" Then
        MsgBox "You must select both From and To accounts."
        Exit Sub
    End If
    If cmbAccounts(0).text = cmbAccounts(1).text Then
        MsgBox "Please select two different accounts."
        Exit Sub
    End If
    If Val(txtAmount.text) <= 0 Then
        MsgBox "You must specify a positive amount."
        Exit Sub
    End If

    'Transfer funds. Note that leaving txtAmount as a
    'string eliminates need to reconvert to text in
    'Transfer procedure.
    Transfer cmbAccounts(0).text, cmbAccounts(0).text, txtAmount.text
End Sub

'need to create Bank Accounts data source, and
'create a test.mdb with Accounts table - use
'VB data manager

Private Sub Form_Load()
    Dim BankWS As Workspace
    Dim BankDB As Database
    Dim BankRecords As Recordset

    'Center the form
    Centerform

    Set BankWS = DBEngine.Workspaces(0)
    Set BankDB = BankWS.OpenDatabase("Accounts.xls", 0, 0, "ODBC;DSN=Excel Corporate data")
GoTo temp
    'Get the account names
    Set BankRecords = BankDB.OpenRecordset("SELECT AccountID from Accounts")

    'Populate the list boxes
    BankRecords.MoveFirst
    Do While Not BankRecords.EOF
        cmbAccounts(0).AddItem BankRecords("AccountID")
        cmbAccounts(1).AddItem BankRecords("AccountID")
        BankRecords.MoveNext
    Loop
temp:
    'And now let's add one bogus account that doesn't exist, so that
    'we can test the transaction should it fail to find an account
    cmbAccounts(0).AddItem "D.B Cooper Savings"
    cmbAccounts(1).AddItem "D.B Cooper Savings"

    'Set the combo lists to the first item
    cmbAccounts(0).ListIndex = 0
    cmbAccounts(1).ListIndex = 0
End Sub


Private Sub Transfer(xferFrom As String, xferTo As String, xferAmt As String)
    Dim BankWS As Workspace
    Dim BankDB As Database
    Dim BankQuery As QueryDef

    On Error GoTo TransferFailed

    Set BankWS = DBEngine.Workspaces(0)
    Set BankDB = BankWS.Databases(0)

    'Start transaction
    BankWS.BeginTrans

    ' Create temporary pass-through query.
    Set BankQuery = BankDB.CreateQueryDef("")

    'Connect to the data source
    BankQuery.Connect = "ODBC;DSN=Bank Accounts"

    'Record the transaction in log
    BankQuery.SQL = "INSERT INTO LogBook (Type, Source, Destination,Amount) VALUES ('Transfer', xferFrom, xferTo, xferAmount)"
    BankQuery.Execute

    'Add funds to xferTo
    BankQuery.SQL = "UPDATE Accounts SET Balance = Balance + " & xferAmt & " WHERE AccountID = " & xferTo
    BankQuery.Execute

    'Check to make sure that there are funds available

    'Deduct funds from xferFrom
    BankQuery.SQL = "UPDATE Accounts SET Balance = Balance - " & xferAmt & " WHERE AccountID = " & xferFrom
    BankQuery.Execute

    'Got this far, so commit the transaction
    BankWS.CommitTrans

    Exit Sub

TransferFailed:
    MsgBox "Error condition. Transaction rolled back."
    BankWS.Rollback       ' If one operation fails, roll them all back.
    Exit Sub
End Sub

Sub Centerform()
    frmODBC.Move (Screen.Width - frmODBC.Width) / 2, (Screen.Height - frmODBC.Height) / 2
End Sub